Attribute VB_Name = "ModSysFunctions"
Public Declare Function CreateFieldDefFile Lib "p2smon.dll" (lpUnk As Object, _
    ByVal fileName As String, ByVal bOverWriteExistingFile As Long) _
    As Long

Public Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long


Public Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long

Private Declare Function WinGetFileVersionInfo Lib "version.dll" _
                        Alias "GetFileVersionInfoA" _
                        (ByVal lptstrFilename As String, _
                        ByVal dwHandle As Long, _
                        ByVal dwLen As Long, _
                        ByVal lpData As String) As Long
                        
Private Declare Function WinGetFileVersionInfoSize Lib "version.dll" _
                        Alias "GetFileVersionInfoSizeA" _
                        (ByVal lptstrFilename As String, _
                        lpdwHandle As Long) As Long
                        
                        Private m_sDateFormat   As String

Private Const LOCALE_SYSTEM_DEFAULT     As Long = &H400
Private Const DATE_LONGDATE             As Long = &H2
Private Const DATE_SHORTDATE            As Long = &H1

                        
Private Declare Sub WinCopyMemory Lib "kernel32" _
                        Alias "RtlMoveMemory" _
                        (ByVal lpDestination As Any, _
                        ByVal lpSource As Long, _
                        ByVal Length As Long)

Private Declare Function Winlstrlen Lib "kernel32" _
                        Alias "lstrlenA" (ByVal lpString As Long) As Long
                        
Private Declare Function WinEnumDateFormats Lib "kernel32" _
                        Alias "EnumDateFormatsA" _
                        (ByVal lpDateFmtEnumProc As Long, _
                        ByVal Locale As Long, _
                        ByVal dwFlags As Long) As Long
                        
Public Function GetShortDateFormat() As String

' 32-bit VB function to retrieve the system "Short Date" format
    
    '   Call the API routine that will enumerate the system date format.
    '   This will call back the bPiEnumDateFormatsProc routine in this
    '   module, passing it a string containing the system Short Date format.
    Call WinEnumDateFormats(AddressOf bPiEnumDateFormatsProc, LOCALE_SYSTEM_DEFAULT, DATE_SHORTDATE)
 
    '   Return the date format that will have been stored module
    '   wide by the routine bPiEnumDateFormatsProc.
    GetShortDateFormat = m_sDateFormat
End Function

Private Function bPiEnumDateFormatsProc(ByVal lpstrFormat As Long) As Long
' The address to this function is passed to the API function
' EnumDateFormatsA that will then call it, passing a pointer
' to a string containing the requested system Date format.
    
    'Store the date format module wide, so that it can be
    'Read by the originating VB function.  As the value passed
    'To this function is a pointer to a string, something that VB
    'Does not directly understand, we use another function to
    'Retrieve the string that the pointer points to.
    m_sDateFormat = sPiGetStringFromPointerANSI(lpstrFormat)
    
    'Return True, Indicating That EnumDateFormatsA can Continue enumerating.
    bPiEnumDateFormatsProc = True
End Function

Private Function sPiGetStringFromPointerANSI(ByVal lPointer As Long) As String

'This function will return the text pointed to by the passed
'pointer.  VB does not support pointers, which are often
'returned by API calls.  This function might be used to retrieve
'a string passed to VB by an API call as a pointer.

    Dim sBuffer     As String
    Dim lSize       As Long
    
    'Get the length of the string pointed to.
    lSize = Winlstrlen(lPointer)
    
    'Size the destination, so that it is large enough.
    sBuffer = String$(lSize + 1, vbNullChar)
    
    'Copy the contents of the memory pointed to
    'by the passed Long value into the Buffer.
    WinCopyMemory sBuffer, lPointer, lSize
    
    'Return the contents of the buffer, up to
    'the first NULL (Ascii 0) which will have been
    'used by the API to indicate the end of the string.
    sPiGetStringFromPointerANSI = Left$(sBuffer, InStr(sBuffer, vbNullChar))
End Function

Public Function FileVersion(ByVal cFile As String) As String
'32-bit VB function to retrieve the string version number of
'the OLEAUT32.DLL to which our process is linked.  The routine
'returns the string version number.

    Dim sVerInfo    As String   ' Holds (string) version data.
    Dim sVersion    As String   ' Working copy of the version data.
    Dim n           As Integer  ' Loop counter
    Dim nPos        As Integer  ' Used in parsing the data.
    Dim sVer        As String   ' Holds the textual Version number
    
    Const sSEARCH   As String = "FILEVERSION"
    
    'Allocate space for the string version information.
    sVerInfo = String$(WinGetFileVersionInfoSize(cFile, 0), 0)
    
    'Retrieve info. If sVerInfo is "" it's OK, we don't need to test it.
    If 0 <> WinGetFileVersionInfo(cFile, 0, Len(sVerInfo), sVerInfo) Then
        
            'We might have to search for the info twice, the first
            'time as an ANSI string, and if that doesn't work
            'the second time as a Unicode string.
            For n = 1 To 2
                
                'Copy the version info, converting it to ANSI
                'from Unicode if this is the second attempt to get it.
                If n = 1 Then
                        sVersion = sVerInfo
                    Else
                        sVersion = StrConv(sVerInfo, vbFromUnicode)
                End If
                
                'Got version stuff - search for 'file version'.
                'This looks like :- FileVersion ?.?.?.?
                nPos = InStr(1, sVersion, sSEARCH, 1)
                
                '   If we found it.
                If 0 <> nPos Then
                    
                    'The version comes after the 'FileVersion' string so chop off everything
                    'until the first byte of the version from the front of the string.
                    sVersion = Trim$(Mid$(sVersion, nPos + Len(sSEARCH)))
                    
                    'Clear any remaining leading NULLS.
                    Do While Left$(sVersion, 1) = vbNullChar
                        sVersion = Right$(sVersion, Len(sVersion) - 1)
                    Loop
                    
                    'The version is terminated by a Null (Chr$(0)).
                    nPos = InStr(sVersion, vbNullChar)
                    
                    'Found the end so pull off nPos bytes to get the version.
                    If 0 <> nPos Then
                    
                        'String version is ...
                        sVer = Left$(sVersion, nPos - 1)
                        
                    End If
                    
                End If
                
                '   If we are left with some text, the Version Info was found.
                If sVer <> "" Then Exit For
            Next n
    End If


    ' Set function return value to the string version in full.
    FileVersion = sVer
                
End Function
